home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / vec.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  10.1 KB  |  387 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: vec.c,v 1.13 94/11/29 06:43:09 wlott Exp $
  27. *
  28. * This file implements vectors.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "gc.h"
  36. #include "coll.h"
  37. #include "class.h"
  38. #include "thread.h"
  39. #include "func.h"
  40. #include "bool.h"
  41. #include "list.h"
  42. #include "num.h"
  43. #include "obj.h"
  44. #include "module.h"
  45. #include "sym.h"
  46. #include "type.h"
  47. #include "error.h"
  48. #include "print.h"
  49. #include "def.h"
  50. #include "vec.h"
  51.  
  52.  
  53. /* Simple object vectors. */
  54.  
  55. obj_t obj_SimpleObjectVectorClass = NULL;
  56.  
  57. obj_t make_vector(int length, obj_t *contents)
  58. {
  59.     obj_t res = alloc(obj_SimpleObjectVectorClass,
  60.               sizeof(struct sovec) + sizeof(obj_t)*(length-1));
  61.  
  62.     SOVEC(res)->length = length;
  63.  
  64.     if (contents)
  65.     memcpy(SOVEC(res)->contents, contents,
  66.            sizeof(obj_t) * length);
  67.  
  68.     return res;
  69. }
  70.  
  71. static void dylan_vector(struct thread *thread, int nargs)
  72. {
  73.     obj_t *args = thread->sp - nargs;
  74.     obj_t res = make_vector(nargs, args);
  75.     obj_t *old_sp = args-1;
  76.  
  77.     *old_sp = res;
  78.     thread->sp = args;
  79.     do_return(thread, old_sp, old_sp);
  80. }
  81.  
  82. static obj_t dylan_sovec_element(obj_t sovec, obj_t index, obj_t def)
  83. {
  84.     int i = fixnum_value(index);
  85.  
  86.     if (0 <= i && i < SOVEC(sovec)->length)
  87.     return SOVEC(sovec)->contents[i];
  88.     else if (def != obj_Unbound)
  89.     return def;
  90.     else {
  91.     error("No element %= in %=", index, sovec);
  92.     return NULL;
  93.     }
  94. }
  95.  
  96. static obj_t dylan_sovec_element_setter(obj_t value, obj_t sovec, obj_t index)
  97. {
  98.     int i = fixnum_value(index);
  99.  
  100.     if (0 <= i && i < SOVEC(sovec)->length)
  101.     SOVEC(sovec)->contents[i] = value;
  102.     else
  103.     error("No element %= in %=", index, sovec);
  104.  
  105.     return value;
  106. }
  107.  
  108. static obj_t dylan_sovec_size(obj_t sovec)
  109. {
  110.     return make_fixnum(SOVEC(sovec)->length);
  111. }
  112.  
  113. static obj_t dylan_vec_make(obj_t class, obj_t size, obj_t fill)
  114. {
  115.     obj_t res;
  116.     int len;
  117.     obj_t *ptr;
  118.  
  119.     len = fixnum_value(check_type(size, obj_FixnumClass));
  120.  
  121.     if (len < 0)
  122.     error("Bogus size: for make %=: %=", class, size);
  123.  
  124.     res = make_vector(len, NULL);
  125.  
  126.     ptr = SOVEC(res)->contents;
  127.     while (len-- > 0)
  128.     *ptr++ = fill;
  129.  
  130.     return res;
  131. }
  132.  
  133. static obj_t dylan_sovec_fill(obj_t /* <simple-object-vector> */ vector,
  134.                   obj_t value, obj_t first, obj_t last)
  135. {
  136.     int start = fixnum_value(check_type(first, obj_FixnumClass));
  137.     int end;
  138.     int size = SOVEC(vector)->length;
  139.     obj_t *ptr;
  140.  
  141.     if (start < 0)
  142.     error("Bogus start: for fill! %=: %=", vector, first);
  143.  
  144.     if (last == obj_Unbound)
  145.     end = size;
  146.     else {
  147.     end = fixnum_value(check_type(last, obj_FixnumClass));
  148.     if (end > size)
  149.         error("Bogus end: for fill! %=: %=", vector, last);
  150.     }
  151.  
  152.     if (start > end)
  153.     error("Bogus range for fill! %=: %d to %d", vector,
  154.           make_fixnum(start), make_fixnum(end));
  155.     
  156.     for (ptr = SOVEC(vector)->contents + start; start < end; start++)
  157.     *ptr++ = value;
  158.     return vector;
  159. }
  160.  
  161. static obj_t dylan_sovec_copy(obj_t /* <simple-object-vector> */ vector,
  162.                   obj_t first, obj_t last)
  163. {
  164.     int start = fixnum_value(check_type(first, obj_FixnumClass));
  165.     int end;
  166.     int size = SOVEC(vector)->length;
  167.     obj_t *ptr;
  168.  
  169.     if (start < 0)
  170.     error("Bogus start: for copy-sequence %=: %=", vector, first);
  171.  
  172.     if (last == obj_Unbound)
  173.     end = size;
  174.     else {
  175.     end = fixnum_value(check_type(last, obj_FixnumClass));
  176.     if (end > size)
  177.         error("Bogus end: for copy-sequence %=: %=", vector, last);
  178.     }
  179.  
  180.     if (start > end)
  181.     error("Bogus range for copy-sequence %=: %d to %d", vector,
  182.           make_fixnum(start), make_fixnum(end));
  183.  
  184.     return make_vector(end - start, SOVEC(vector)->contents + start);
  185. }
  186.  
  187.  
  188. /* Byte Vector support. */
  189.  
  190. obj_t obj_ByteVectorClass = NULL;
  191.  
  192. obj_t make_byte_vector(int length, unsigned char *contents)
  193. {
  194.     obj_t res = alloc(obj_ByteVectorClass,
  195.               sizeof(struct bytevec) + length - 1);
  196.  
  197.     BYTEVEC(res)->length = length;
  198.  
  199.     if (contents)
  200.     memcpy(BYTEVEC(res)->contents, contents, length);
  201.  
  202.     return res;
  203. }
  204.  
  205. static obj_t dylan_bytevec_element(obj_t bytevec, obj_t index, obj_t def)
  206. {
  207.     int i = fixnum_value(index);
  208.  
  209.     if (0 <= i && i < BYTEVEC(bytevec)->length)
  210.     return make_fixnum(BYTEVEC(bytevec)->contents[i]);
  211.     else if (def != obj_Unbound)
  212.     return def;
  213.     else {
  214.     error("No element %= in %=", index, bytevec);
  215.     return NULL;
  216.     }
  217. }
  218.  
  219. static obj_t dylan_bytevec_element_setter(obj_t value, obj_t bytevec,
  220.                       obj_t index)
  221. {
  222.     int i = fixnum_value(index);
  223.  
  224.     if (0 <= i && i < BYTEVEC(bytevec)->length)
  225.     BYTEVEC(bytevec)->contents[i] = fixnum_value(value);
  226.     else
  227.     error("No element %= in %=", index, bytevec);
  228.  
  229.     return value;
  230. }
  231.  
  232. static obj_t dylan_bytevec_size(obj_t bytevec)
  233. {
  234.     return make_fixnum(BYTEVEC(bytevec)->length);
  235. }
  236.  
  237. static obj_t dylan_byte_vec_make(obj_t class, obj_t size, obj_t fill)
  238. {
  239.     obj_t res;
  240.     int len, byte;
  241.  
  242.     len = fixnum_value(check_type(size, obj_FixnumClass));
  243.     if (len < 0)
  244.     error("Bogus size: for make %=: %d", class, size);
  245.  
  246.     byte = fixnum_value(check_type(fill, obj_FixnumClass));
  247.     if (byte < 0 || byte > 255)
  248.     error("Bogus fill: for make %=: %d", class, fill);
  249.  
  250.     res = make_byte_vector(len, NULL);
  251.  
  252.     memset(BYTEVEC(res)->contents, byte, len);
  253.  
  254.     return res;
  255. }
  256.  
  257.  
  258.  
  259. /* Printing support. */
  260.  
  261. static void print_sovec(obj_t sovec)
  262. {
  263.     int len = SOVEC(sovec)->length;
  264.     int i;
  265.  
  266.     printf("#[");
  267.     for (i = 0; i < len; i++) {
  268.     if (i)
  269.         printf(", ");
  270.     prin1(SOVEC(sovec)->contents[i]);
  271.     }
  272.     printf("]");
  273. }
  274.  
  275.  
  276. /* GC stuff. */
  277.  
  278. static int scav_sovec(struct object *ptr)
  279. {
  280.     struct sovec *v = (struct sovec *)ptr;
  281.     int len = v->length;
  282.     int i;
  283.     
  284.     for (i = 0; i < len; i++)
  285.     scavenge(v->contents + i);
  286.  
  287.     return sizeof(struct sovec) + sizeof(obj_t)*(len-1);
  288. }
  289.  
  290. static obj_t trans_sovec(obj_t v)
  291. {
  292.     int len = SOVEC(v)->length;
  293.     return transport(v, sizeof(struct sovec) + sizeof(obj_t)*(len-1));
  294. }
  295.  
  296. static int scav_bytevec(struct object *ptr)
  297. {
  298.     struct bytevec *v = (struct bytevec *)ptr;
  299.     
  300.     return sizeof(struct bytevec) + v->length - sizeof(v->contents);
  301. }
  302.  
  303. static obj_t trans_bytevec(obj_t v)
  304. {
  305.     return transport(v, sizeof(struct bytevec) + BYTEVEC(v)->length - sizeof(((struct bytevec *)v)->contents));
  306. }
  307.  
  308. void scavenge_vec_roots(void)
  309. {
  310.     scavenge(&obj_SimpleObjectVectorClass);
  311.     scavenge(&obj_ByteVectorClass);
  312. }
  313.  
  314.  
  315.  
  316. /* Initialization stuff. */
  317.  
  318. void make_vec_classes(void)
  319. {
  320.     obj_SimpleObjectVectorClass = make_builtin_class(scav_sovec, trans_sovec);
  321.     obj_ByteVectorClass = make_builtin_class(scav_bytevec, trans_bytevec);
  322. }
  323.  
  324. void init_vec_classes(void)
  325. {
  326.     init_builtin_class(obj_SimpleObjectVectorClass, "<simple-object-vector>",
  327.                obj_VectorClass, NULL);
  328.     def_printer(obj_SimpleObjectVectorClass, print_sovec);
  329.     init_builtin_class(obj_ByteVectorClass, "<byte-vector>",
  330.                obj_VectorClass, NULL);
  331. }
  332.  
  333. void init_vec_functions(void)
  334. {
  335.     define_constant("vector",
  336.             make_raw_function("vector", 0, TRUE, obj_False, FALSE,
  337.                       list1(obj_SimpleObjectVectorClass),
  338.                       obj_False, dylan_vector));
  339.     define_method("element",
  340.             list2(obj_SimpleObjectVectorClass, obj_FixnumClass),
  341.             FALSE, list1(pair(symbol("default"), obj_Unbound)), FALSE,
  342.             obj_ObjectClass, dylan_sovec_element);
  343.     define_method("element-setter",
  344.           list3(obj_ObjectClass,
  345.             obj_SimpleObjectVectorClass,
  346.             obj_FixnumClass),
  347.           FALSE, obj_False, FALSE,
  348.           obj_ObjectClass, dylan_sovec_element_setter);
  349.     define_method("size", list1(obj_SimpleObjectVectorClass),
  350.           FALSE, obj_False, FALSE, obj_FixnumClass,
  351.           dylan_sovec_size);
  352.     define_method("make", list1(singleton(obj_VectorClass)), FALSE,
  353.           list2(pair(symbol("size"), make_fixnum(0)),
  354.             pair(symbol("fill"), obj_False)),
  355.           FALSE, obj_SimpleObjectVectorClass, dylan_vec_make);
  356.     define_method("make", list1(singleton(obj_SimpleObjectVectorClass)), FALSE,
  357.           list2(pair(symbol("size"), make_fixnum(0)),
  358.             pair(symbol("fill"), obj_False)),
  359.           FALSE, obj_SimpleObjectVectorClass, dylan_vec_make);
  360.  
  361.     define_method("element",
  362.           list2(obj_ByteVectorClass, obj_FixnumClass),
  363.           FALSE, list1(pair(symbol("default"), obj_Unbound)),
  364.           FALSE, obj_FixnumClass, dylan_bytevec_element);
  365.     define_method("element-setter",
  366.           list3(obj_FixnumClass,
  367.             obj_ByteVectorClass,
  368.             obj_FixnumClass),
  369.           FALSE, obj_False, FALSE,
  370.           obj_FixnumClass, dylan_bytevec_element_setter);
  371.     define_method("size", list1(obj_ByteVectorClass),
  372.           FALSE, obj_False, FALSE,
  373.           obj_FixnumClass, dylan_bytevec_size);
  374.     define_method("fill!", list2(obj_SimpleObjectVectorClass, obj_ObjectClass),
  375.           FALSE, list2(pair(symbol("start"), make_fixnum(0)),
  376.                    pair(symbol("end"), obj_Unbound)),
  377.           FALSE, obj_SimpleObjectVectorClass, dylan_sovec_fill);
  378.     define_method("copy-sequence", list1(obj_SimpleObjectVectorClass),
  379.           FALSE, list2(pair(symbol("start"), make_fixnum(0)),
  380.                    pair(symbol("end"), obj_Unbound)),
  381.           FALSE, obj_SimpleObjectVectorClass, dylan_sovec_copy);
  382.     define_method("make", list1(singleton(obj_ByteVectorClass)), FALSE,
  383.           list2(pair(symbol("size"), make_fixnum(0)),
  384.             pair(symbol("fill"), make_fixnum(0))),
  385.           FALSE, obj_ByteVectorClass, dylan_byte_vec_make);
  386. }
  387.